
const info = """
felth nim release-1 development
world-reset-on-eval monolithic-file
by-debris https://notabug.org/debris/felth (nim branch)
type \q to exit
"""
import std/[tables,macros,strutils,deques,math]
type
    FMissing = enum zil
    FKind = enum
        number,glyphs,ordinal,cunit,boolean,list,table,missing
    FPoint = ref FContainer
    FContainer = object
        case fKind: FKind
        of cunit: cunit : Fcunit
        of number: number: BiggestFloat
        of glyphs: glyphs: string
        of ordinal: ordinal: BiggestUInt
        of boolean: boolean: bool
        of list: list: seq[FPoint]
        of table: table: TableRef[string,FPoint]
        of missing: missing : FMissing
        #Null pointer: this might not work; try just discarding this branch instead? but then i'd need a specific overload since there wouldnt be a field.
    FEnv = TableRef[string,FPoint]
    FWorld = ref object
        env : FEnv
        front  :  Deque[string]
        rear  :  seq[FPoint]
    Fcunit = object
        case idempotent: bool
        of false: immediate :  proc(world:var FWorld):void
        of true: procedure :  proc(containers: varargs[FPoint]):FPoint

template newPoint(varkind : FKind, val: untyped): FPoint = 
  FPoint(fKind: varkind, varkind: val)
template newImmediate(w:untyped, body : untyped) : FPoint =
        cunit.newPoint(Fcunit(idempotent:false,immediate: proc(w:var FWorld) = body))
let missingPoint = missing.newPoint(zil)

macro getStringOfPoint(val: FPoint, kindEnum: typed): untyped = # credit due: @elegantbeef:matrix.org
    #sacrifices a lamb to Äst, god of syntax trees, to get the value of an FPoint
  echo val.getTypeImpl.treeRepr # Could use this instead of passing myEnum
  result = nnkCaseStmt.newTree(nnkDotExpr.newTree(val, ident"fKind"))
  for kind in kindEnum.getImpl[^1][1..^1]:
    result.add:
      nnkOfBranch.newTree(
        kind,
        newCall("$", nnkDotExpr.newTree(val, ident $kind))
      )
  echo result.treerepr

proc `$`(point: FPoint): string =
  getStringOfPoint(point, FKind)
proc push[T](x: var seq[T], item: sink T) : seq[T] =
    x.insert(item,x.len)
    return x
#[ END OUTER DEFINITIONS
#[~------------------------~]#
    BEGIN FELTH DEFINITIONS ]#
proc Feval(world: var FWorld) : FWorld
macro newAlgebraic(opkind : untyped,operation : untyped) : proc =
    result = quote do:
        proc(points : varargs[FPoint]) : FPoint =
            if varargsLen(points) <= 0:
                return missingPoint
            var accumulator = points[0]
            for point in points:
                assert(point.fKind==`opkind`,": FPoint kinds mismatched!")
                if point != accumulator:
                    accumulator.`opkind` = `operation`(accumulator.`opkind`,point.`opkind`)
            return accumulator

proc `addFloat64`(f:BiggestFloat,g:BiggestFloat) : BiggestFloat =f+g
proc `subFloat64`(f:BiggestFloat,g:BiggestFloat) : BiggestFloat =f-g
proc `mulFloat64`(f:BiggestFloat,g:BiggestFloat) : BiggestFloat =f*g
proc `divFloat64`(f:BiggestFloat,g:BiggestFloat) : BiggestFloat =f/g #This could be implemented differently for higher speed manually, I think. ie. f/(g*h*i*j).
proc `concatStr`(s:string,t:string) : string =s&t
let 
    addition = newAlgebraic(number,addFloat64)
    substract= newAlgebraic(number,subFloat64)
    multiply = newAlgebraic(number,mulFloat64)
    divide   = newAlgebraic(number,divFloat64)
    concat   = newAlgebraic(glyphs,concatStr)
var defaultenv = FEnv({ "#=": block:
                            newImmediate(w):
                                let
                                    Kp : string= w.front.popFirst() # key, token
                                    Vp : FPoint = w.rear.pop() # value, any
                                w.env[Kp] = Vp,
                        "DEFMACRO#": block:
                            newImmediate(w):
                                let
                                    Kp : string= w.front.popFirst() # key, token
                                    Sp : string = w.front.popFirst() # sep, string
                                var 
                                    Cp : string = w.front.popFirst() # currenttoken, string
                                    Aq : FWorld.front = @[""].toDeque() # accumulatormacro, strings
                                Aq.popFirst
                                while Sp != Cp:
                                    Aq.addLast(Cp)
                                    Cp = w.front.popFirst()
                                w.env[Kp]= block:
                                    newImmediate(w):
                                        let Cfront : FWorld.front = w.front
                                        w.front = Aq
                                        discard Feval(w)
                                        w.front = Cfront
                        ,"+":cunit.newPoint(Fcunit(idempotent:true,procedure:addition))
                        ,"-":cunit.newPoint(Fcunit(idempotent:true,procedure:substract))
                        ,"*":cunit.newPoint(Fcunit(idempotent:true,procedure:multiply))
                        ,"/":cunit.newPoint(Fcunit(idempotent:true,procedure:divide))
                        ,"..":cunit.newPoint(Fcunit(idempotent:true,procedure:concat))
                        ,"ORD#": block:
                            newImmediate(w):
                                let Up : string = w.front.popFirst()
                                var Rp : FPoint
                                try:
                                    Rp = ordinal.newPoint(Up.parseBiggestUInt())
                                except:
                                    echo "!< MisparsableLiteralOrdinal\n^\tNoFatal\n+---\t",Up
                                    Rp = missingPoint
                                finally:
                                    discard w.rear.push(Rp)
                        ,"GLYPHS#": block:
                            newImmediate(w):
                                let
                                    Sp : string = w.front.popFirst() # sep, string
                                var 
                                    Cp : string = w.front.popFirst() # currenttoken, string
                                    Ap : FPoint = glyphs.newPoint("") # accumulatortoken, string
                                while Sp != Cp:
                                    Ap.glyphs = Ap.glyphs & Cp & " "
                                    Cp = w.front.popFirst()
                                Ap.glyphs.setLen(Ap.glyphs.len-1)
                                discard w.rear.push(Ap)
                        ,"#log": block:
                            newImmediate(w):
                                echo "#logrear:" & $w.rear
                        ,"!": block:
                            newImmediate(w):
                                let 
                                    Zp : FPoint = w.rear.pop() # ordinal preferably, number accepted
                                    Fp : FPoint = w.rear.pop() # procedure
                                var Q : seq[FPoint] = @[]
                                var Z : uint64
                                if Zp.fKind == number:
                                    let sig : int = Zp.number.sgn
                                    if sig == -1:
                                        Z = uint64(w.rear.len + int(Zp.number) ) 
                                        #[ Fun fact, this originally was considered a bug (read: unintended feature)
                                           from how Janet handled negative numbers in its !'s definition. Seems useful.
                                           It's trivial to implement, so it's been added in other implementations.]#
                                    elif sig != 0:
                                        Z = uint64(Zp.number)-1 #Felth is 1-indexed.
                                    if sig != 0: # Yes this looks weird; no it doesn't works if you remove this if line.
                                        for I in 0..Z:
                                                discard Q.push(w.rear.pop())
                                    #else: #then Q must stay empty. Do not do anything.
                                elif Zp.fKind == ordinal:
                                    Z = Zp.ordinal
                                    if Z != 0:
                                        for I in 0..Z:
                                            discard Q.push(w.rear.pop())
                                    #else: see line 125
                                discard w.rear.push(Fp.cunit.procedure(Q))
                        }.newTable)
let defaultrear : FWorld.rear = @[] #new FWorld.rear
proc newWorld(env : FWorld.env = defaultenv , rear : FWorld.rear = defaultrear ) : FWorld = #, front : FWorld.front = void ) : FWorld = 
    return FWorld(env: env, rear: rear)
#[ END FELTH DEFINITIONS
#[~------------------------~]#
      BEGIN EVAL DEFINITION ]#
proc Ftokenize(source:string) : FWorld.front =
    return source.splitWhitespace().toDeque
# pop is already implemented
proc Feval(world: var FWorld) : FWorld =
    var 
        token : string
        value : FPoint
    while world.front.len() > 0: # front's size changes nondeterministically ; ie. immediates may push to it mid-execution
         token = world.front.popFirst() # it's a deque
         try:
            value = world.env[token]
         except KeyError: # key not found: nope
            try:
                value = number.newPoint(token.parseFloat()) #=> value = tonumber(token)
            except ValueError:
                value = missingPoint # => value = zilch
         if (value.fKind == cunit) and not value.cunit.idempotent: #callable unit is not idempotent ; this means it's an immediate and must be called on world:
             value.cunit.immediate(world) #apply immediate. only side effect, do not push!
         else: #push `value` to rear seq
             discard world.rear.push(value)
    return world
#--USER INTERFACE--#
echo info
var input : string
while input != "\\q":
    write(stdout,"=>")
    var world : FWorld = newWorld()
    try:
        input = readLine(stdin)
        world.front = input.Ftokenize
        world = Feval(world)
    except: #Ignore warning, CatchableException doesn't covers everything properly
        echo "@< exception:\n^\t" , getCurrentException().name , "\n+---\t" , getCurrentExceptionMsg()
    finally:
        echo "=<" , $world.rear
